home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte1286.arc / DIRDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1986-10-29  |  9KB  |  287 lines
  1.  
  2. program DirectoryDemo;
  3. {
  4.    Demonstration of how to search a PC-DOS/MS-DOS file directory for
  5.    a file specification, which can contain global characters ('*' and '?'),
  6.    using DOS function calls hex 4E and hex 4F.    Displays a list of names
  7.    and sizes of files which match the specification.
  8.  
  9.    Program compiles correctly under versions 2 and 3 of Turbo Pascal.
  10.    Tested under IBM PC-DOS ver 2.10 and 3.0, and Compaq MS-DOS 2.11.
  11.  
  12.    Copyright June 1985 by D.F. Yriart.
  13.  
  14.    Sub-directory attribute test modified 28 July 1985.
  15. }
  16.  
  17. type
  18.     UserSpec     = string[64];
  19.     Registers     = record
  20.              AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
  21.            end;
  22.     FileName     = string[13];
  23.     DTAPointer     = ^DTARecord;
  24.     DTARecord     = record  { Layout of DTA on return from calls }
  25.              DOSReserved : array[1..21] of byte;
  26.              Attribute     : byte;
  27.              FileTime,         { packed in special format }
  28.              FileDate,         {    "    "    "       "   }
  29.              SizeLow,
  30.              SizeHigh     : integer;
  31.              FoundName     : array[1..13] of char;
  32.            end;
  33.  
  34. const
  35.      NUL      = ^@;    { character 0, used to terminate ASCIIZ string }
  36.      SeekAttrib = $10;    { search for files & sub-directories           }
  37.  
  38. var
  39.    TransferRec    : DTAPointer; { will point to program DTA     }
  40.    MatchPtrn    : UserSpec;   { in Turbo Pascal string format }
  41.    RetName    : FileName;   { name found by call          }
  42.    FilSize    : Real;       { size of file found          }
  43.    Count    : Integer;
  44.    NoFind, LastFile,
  45.      SubDirec    : Boolean;
  46.  
  47. procedure PointDTA(Var DTARec : DTAPointer);
  48. {
  49.     Use function hex 2F to locate the starting address of the Data
  50.     Transfer Area (DTA) and point to it.
  51.  
  52.     Pointer will be used by file match procedures to find the data
  53.     returned in the DTA.
  54. }
  55.  
  56. Const    GetDTA = $2F00;   { function number }
  57.  
  58. var
  59.    Regs : Registers;
  60.  
  61. Begin
  62.      Regs.AX := GetDTA;   { load function number }
  63.      MsDos(Regs);      { make call to DOS     }
  64.  
  65.      { On return from call to GetDTA, ES register contains DTA segment
  66.        address, BX register contains DTA offset in segment }
  67.  
  68.      DTARec := Ptr(Regs.ES,Regs.BX);     { Set pointer }
  69. End;
  70.  
  71. function SizeOfFile(HiWord, LoWord : Integer) : Real;
  72. {
  73.    Converts the file size returned by DOS in two 16 bit words (unsigned
  74.    integers) into a real number.
  75. }
  76.  
  77. Var
  78.    BigNo, Size : Real;
  79.  
  80. Begin
  81.      BigNo := (MaxInt * 2.0) + 2;
  82.      if HiWord < 0 then Size := (BigNo + HiWord) * BigNo
  83.     else Size := HiWord * BigNo;
  84.      if LoWord >= 0 then Size := Size + LoWord
  85.     else Size := Size + (BigNo + LoWord);
  86.      SizeOfFile := Size
  87. End;
  88.  
  89. procedure FindFirst(Pattern : UserSpec; Var Found : FileName; Var Size : Real;
  90.             Var NoMatch : Boolean; Var LastOne : Boolean;
  91.             Var SubDir : Boolean);
  92. {
  93.    Function hex 4E returns first file name that matches user's specification.
  94.  
  95.    If an error occurs, the carry flag will be set and DOS will return error
  96.    code 2 or 18 in the AX register.  The procedure sets NoMatch and LastOne
  97.    depending on the error code.
  98.  
  99.    The filespec to search for must be stored as an ASCIIZ string, terminated
  100.    by a byte of binary zeros (character NUL).  When the call is made, the
  101.    DS and DX registers point to the ASCIIZ string.
  102.  
  103.    The file attribute to search for can be loaded in the CX register.
  104.  
  105.    If a match occurs, the DTA will be loaded with information about
  106.    the file which was found.  This procedure recovers the file name and
  107.    attribute of the found file.  SubDir returns true if the file's
  108.    attribute is "subdirectory".
  109. }
  110.  
  111. Const    FindFirst   = $4E00;  { function number }
  112.  
  113. Type
  114.     ASCIIZ     = array[1..64] of char;
  115.  
  116. var
  117.    FileSpec : ASCIIZ;     { search pattern in DOS ASCIIZ string format    }
  118.    Regs     : Registers;
  119.    PosInStr,
  120.    Count    : Integer;
  121.    FoundLen : Byte absolute Found;
  122.  
  123. Begin
  124.      { Convert the file name to an ASCIIZ string for the function call. }
  125.      for PosInStr := 1 to length(Pattern) do
  126.      FileSpec[PosInStr] := Pattern[PosInStr];
  127.      FileSpec[length(Pattern) + 1] := NUL;
  128.  
  129.      With Regs do
  130.      begin
  131.       DS := Seg(FileSpec);     { Point to ASCIIZ string }
  132.       DX := Ofs(FileSpec);
  133.       CX := SeekAttrib;     { File attribute to look for }
  134.       AX := FindFirst;     { load function number   }
  135.       MsDos(Regs);
  136.       if (Flags and 1) > 0 then    { test carry flag }
  137.         begin   { Handle error return codes }
  138.            Case AX of
  139.             2 : begin    { No match }
  140.                NoMatch := True;
  141.                LastOne := True;
  142.             end;
  143.            18 : begin    { No more files }
  144.                NoMatch := False;
  145.                LastOne := True;
  146.             end;
  147.            else
  148.            writeln(^G'Can''t interpret error return code');
  149.            Halt;
  150.            end;   { Case }
  151.         end
  152.       else
  153.         begin   { No error return code }
  154.            NoMatch := False;
  155.            LastOne := False;
  156.         end;
  157.      end;   { with Regs }
  158.  
  159.      { Capture returned file name and attribute, other information
  160.        such as file size, time and date is also returned in the DTA.
  161.        TransferRec points to the record superimposed on the DTA.    }
  162.  
  163.      if (not NoMatch) then
  164.      with TransferRec^ do
  165.      begin
  166.     Found := FoundName;
  167.  
  168.     { Find number of characters returned in the file name area }
  169.     Count := 0;
  170.     While Found[Count] <> NUL do Count := Count + 1;
  171.     FoundLen := Count;   { set the length of the name string }
  172.  
  173.     { Blank out any garbage characters passed from the DTA     }
  174.     For Count := length(Found) + 1 to 13 do Found := Found + ' ';
  175.  
  176.     { Test whether the file is a subdirectory and set flag.  }
  177.     if (Attribute and SeekAttrib) > 0 then SubDir := True
  178.        else SubDir := False;
  179.  
  180.     { Get the file size if file is not a subdirectory. }
  181.     if not SubDir then Size := SizeOfFile(SizeHigh,SizeLow)
  182.        else Size := 0.0;
  183.  
  184.      end;   { with TransferRec }
  185. End;
  186.  
  187. procedure FindNext(Var Found : FileName; Var Size : Real;
  188.            Var LastOne : Boolean; Var SubDir : Boolean);
  189. {
  190.    Function hex 4F returns next matching file name.  When error 18 is
  191.    returned there are no more matches.    The search criteria set up by
  192.    function hex 4E are used by this call, and information is returned
  193.    in the DTA as described for procedure FindFirst.
  194. }
  195.  
  196. Const    FindNext    = $4F00;   { function number }
  197.  
  198. var
  199.    Regs  : Registers;
  200.    Count : Integer;
  201.    FoundLen : Byte absolute Found;
  202.  
  203. Begin
  204.      With Regs do
  205.      begin
  206.       AX := FindNext;
  207.       MsDos(Regs);
  208.       if (Flags and 1) > 0 then { Handle error return codes }
  209.          if AX = 18 then LastOne := True    { No more files }
  210.          else
  211.         begin
  212.            writeln(^G'Can''t interpret error return code');
  213.            Halt;
  214.         end
  215.       else LastOne := False;   { No error return code }
  216.      end;  { with Regs }
  217.  
  218.      { Capture returned file name and attribute }
  219.      with TransferRec^ do
  220.      begin
  221.       Found := FoundName;
  222.  
  223.       { Set length of file name and clear "garbage." }
  224.       Count := 0;
  225.       While Found[Count] <> NUL do Count := Count + 1;
  226.       FoundLen := Count;
  227.       For Count := length(Found) + 1 to 13 do Found := Found + ' ';
  228.  
  229.       { Test for subdirectory.      }
  230.     if (Attribute and SeekAttrib) > 0 then SubDir := True
  231.        else SubDir := False;
  232.  
  233.       { Get the file size if file is not a subdirectory. }
  234.       if not SubDir then
  235.         Size := SizeOfFile(SizeHigh,SizeLow)
  236.       else Size := 0.0;
  237.  
  238.      end;    { with TransferRec }
  239. End;
  240.  
  241. {
  242.            **********************************
  243.            *          MAIN PROGRAM        *
  244.            **********************************
  245. }
  246.  
  247. BEGIN
  248.      ClrScr;
  249.      writeln(' -- Demonstration of Directory Search Calls --');
  250.      write('    Find? ');
  251.      readln(MatchPtrn);    { The user's search specification }
  252.      writeln;
  253.      Count := 0;
  254.  
  255.      PointDTA(TransferRec);   { Set the DTA pointer }
  256.  
  257.      { Call function hex 4E to search for first match.            }
  258.      FindFirst(MatchPtrn,RetName,FilSize,NoFind,LastFile,SubDirec);
  259.  
  260.      if NoFind or LastFile then writeln('File not found.')
  261.     else
  262.        begin
  263.           { Display additional matches and keep looking until no
  264.         more are found.  Display in three columns.          }
  265.  
  266.           While (not LastFile) do
  267.         begin
  268.            if SubDirec then LowVideo;  { Display subdirectories in }
  269.            write(RetName,'  ',FilSize:8:0,'   ');  { low intensity.  }
  270.            NormVideo;
  271.            Count := Count + 1;
  272.            if (Count mod 3) = 0 then Writeln;
  273.            { Call function hex 4F to search for another match.    }
  274.            FindNext(RetName,FilSize,LastFile,SubDirec);
  275.           end;
  276.        end;
  277.  
  278.      { Close up the display with a count of files found. }
  279.      if (Count mod 3) <> 0 then writeln;
  280.      writeln;
  281.      write('*** ',Count,' Files or ');
  282.      LowVideo;
  283.      write('Sub-Directories');
  284.      NormVideo;
  285.      writeln(' found ***');
  286. END.
  287. ** '